home *** CD-ROM | disk | FTP | other *** search
/ Night Owl 6 / Night Owl's Shareware - PDSI-006 - Night Owl Corp (1990).iso / 026a / j1_xtab.zip / JP1_XTAB.PRG < prev   
Text File  |  1990-09-23  |  40KB  |  1,163 lines
  1. **   File:              JP1_XTAB.PRG
  2. **   Authors:           Bill Ramos and Kirk Nason, Ashton-Tate
  3. **   Modifications:     Jay Parsons, CIS 70160,340, A-T BBS Jparsons
  4. **   Date:              September 23, 1990
  5.  
  6. **   Description:       Crosstab function and related functions and
  7. **                      procedures from the CCBOOSTR.PRG file,
  8. **                      modified in two respects:
  9.  
  10. **                      1) Support for AVG, STD and VAR tabulations;
  11. **                      2) Columns and rows summarized.
  12.  
  13. **   Notes:             Two asterisks "**" introduce mods by Jay Parsons (JP).
  14. **                      All else is original code.
  15.  
  16. **                      This file does NOT contain all the functions,
  17. **                      procedures and macros required to run it.  It
  18. **                      replaces only the following items from CCBOOSTR.PRG:
  19.  
  20. **                      FUNCTION Crosstab
  21. **                      PROCEDURE XT_DisGets
  22. **                      PROCEDURE Com_XTab
  23.  
  24. **                      To use this file, copy CCBOOSTR.PRG to another file,
  25. **                      delete the named items only from it, append this file,
  26. **                      declare/compile it with SET PROC TO, and proceed.
  27.  
  28. **  Modifications Copyright (C) 1990, Jay Parsons.
  29.  
  30. **  License is granted to all persons to use these mods for personal purposes.
  31. **  License is granted to developers to distribute the compiled code as part
  32. **  of dBASE or RunTime custom applications, provided that the developer
  33. **  assumes all obligations of support.  Distribution of the source or compiled
  34. **  code of the modifications for any consideration, whether alone or as part
  35. ** of any other product, is otherwise prohibited.
  36.  
  37. **  No warranty of merchantability, fitness for any purpose or otherwise is
  38. **  made, and use of the modifications is at the user's sole risk.
  39.  
  40. **  The foregoing statements should not be understood to imply that the author
  41. **  of the modifications has title to the original code or any right to permit
  42. **  or regulate use or sale of the original code.
  43.                                        
  44. FUNCTION CrossTab   && UDS for Capturing Parameters for CrossTab
  45. *-----------------------------------------------------------------------
  46. * Capture CrossTab parameters for COM_XTAB
  47. *
  48. * Synopsis:
  49. * 
  50. * CROSSTAB( )
  51. * 
  52. * Description:
  53. * 
  54. * The CrossTab() function displays the front end to capture the 
  55. * parameters for the COM_XTAB (compute crosstab) procedure.
  56. * The CrossTab() function is called from within the QBE design
  57. * surface by placing the function CROSSTAB() in any one of the field
  58. * skeletons.  CrossTab() will not work within the file pothandle.
  59. * 
  60. * The user then fills in the optional title, the column to summarize
  61. * across the top, the column to summarize along the side, the column
  62. * to compute in the middle, and the type of operation (SUM,CNT,MAX,MIN).
  63. **  Operations AVG,STD and VAR added.  JP.
  64. * 
  65. * If the user presses F2 to perform the crosstab, the CrossTab() will
  66. * remove the CROSSTAB() reference from the skeleton and keyboard in
  67. * the commands to transfer to the Applications Panel in the Control
  68. * Center and run EXECCROS.
  69. * 
  70. * If the user presses Ctrl-End to save, but not execute, the CrossTab(), 
  71. * the CrossTab() function will save the parameters to the CROSSTAB.MEM 
  72. * file and clear out the CROSSTAB() reference from the skeletion.
  73. * 
  74. * If the user presses Escape to cancel, the CrossTab() will not save
  75. * any of the values and clear out the CROSSTAB() reference from 
  76. * the skeletion.
  77. * 
  78. * The summary field must be numeric.  The top and side fields can be
  79. * any type but memo.
  80. * 
  81. * See also:
  82. * 
  83. * EXECCROS.PRG    Run the CrossTab and display the results
  84. * COM_XTAB.PRG    Perform the actual CrossTab computations
  85. * 
  86. *-----------------------------------------------------------------------
  87.  
  88.   PRIVATE lc_talk, lc_cursor, lc_display, lc_status, lc_carry, lc_proc,;
  89.   ln_typeahd
  90.  
  91.   SAVE SCREEN TO qbe
  92.   IF SET("TALK") = "ON"
  93.     SET TALK OFF
  94.     lc_talk = "ON"
  95.   ELSE
  96.     lc_talk = "OFF"
  97.   ENDIF
  98.   lc_cursor = SET("CURSOR")
  99.   SET CURSOR ON
  100.  
  101.   lc_escape = SET("ESCAPE")
  102.   SET ESCAPE OFF
  103.   lc_status = SET("STATUS")
  104.   lc_safety = SET("SAFETY")
  105.   SET SAFETY OFF
  106.  
  107.   IF TYPE("kn_esc") = "U"
  108.     DO key_vars
  109.   ENDIF
  110.  
  111.   ll_iscolor = IIF( SET( "COLOR" ) = "ON", .t., .f. )
  112.   IF TYPE("SAYCOLOR") = "U"
  113.     PUBLIC saycolor
  114.     IF ll_iscolor
  115.       saycolor = "rg+"
  116.     ELSE
  117.       saycolor = "w/n"
  118.     ENDIF
  119.   ENDIF
  120.   IF TYPE("FILLCOLOR") = "U"
  121.     PUBLIC fillcolor
  122.     IF ll_iscolor
  123.       fillcolor = "gb+"
  124.     ELSE
  125.       fillcolor = "n"
  126.     ENDIF
  127.   ENDIF
  128.   IF TYPE("MESSCOLOR") = "U"
  129.     PUBLIC messcolor
  130.     messcolor = COLOR("MESSAGE")
  131.     ln_slash = AT("/", messcolor)
  132.     ln_plus  = AT("+", messcolor)
  133.     IF ln_plus = 0
  134.       messcolor = "+" + messcolor
  135.     ELSE
  136.       IF ln_plus > ln_slash
  137.         messcolor = "+" + messcolor
  138.       ENDIF
  139.     ENDIF
  140.   ENDIF
  141.  
  142.   DEFINE WINDOW Crosstab FROM 5,7 TO 18,73 DOUBLE
  143.   DO shadowg WITH 5,7,18,73
  144.   ACTIVATE WINDOW Crosstab
  145.  
  146.   DO XT_DisSays
  147.  
  148.   DO XT_IniVars
  149.  
  150. *-- Check to see if a numeric field is present in the DBF
  151.   ll_numpres = .F.
  152.   ln_fldcnt = 1
  153.   DO WHILE .NOT. EMPTY( FIELD( ln_fldcnt ) )
  154.     IF TYPE( FIELD( ln_fldcnt ) ) $ "NF"
  155.       ll_numpres = .T.
  156.       EXIT
  157.     ENDIF
  158.     ln_fldcnt = ln_fldcnt + 1
  159.   ENDDO
  160.   IF ll_numpres                        && Numeric field found
  161. **  Next line replaced with expanded options. JP
  162. **  gc_actlist = "@M SUM,CNT,MAX,MIN"  && Give the full set of options
  163.     gc_actlist = "@M SUM,CNT,MAX,MIN,AVG,STD,VAR"  && Give full set of options
  164.   ELSE
  165.     gc_actlist = "@M CNT,MAX,MIN"      && Else allow all but SUM
  166.   ENDIF
  167.  
  168.   ON KEY LABEL f2       DO XT_F2Exit
  169.   ON KEY LABEL shift-f1 DO XT_FldPick  WITH VARREAD()
  170.   ll_escape = .F.
  171.   ll_edit = .T.
  172.   ll_f2 = .F.
  173.   DO WHILE ll_edit
  174.     DO XT_DisGets
  175.     READ
  176.     ln_readkey = READKEY()
  177.     DO CASE
  178.       CASE ln_readkey = rn_Esc
  179.         ll_escape = .T.
  180.         ll_edit = .F.
  181.       CASE ln_readkey = rn_CtrlEnd
  182.         IF EMPTY( gc_xtop ) .OR. EMPTY( gc_xside ) .OR. EMPTY( gc_xsum )
  183.           ll_edit = .T.
  184.           ACTIVATE SCREEN
  185.           @ 24,0
  186.           DO Beep
  187.           lc_msg = "The top, side, and summary fields must be specified" + ;
  188.                    " (Press SPACE)"
  189.           @ 24, Center( lc_msg,80 ) SAY lc_msg COLOR &messcolor
  190.           ln_tmp = INKEY(0)
  191.           @ 24,0
  192.           ACTIVATE WINDOW CrossTab
  193.         ELSE
  194.           ll_edit = .F.
  195.         ENDIF
  196.     ENDCASE
  197.   ENDDO
  198.   ON KEY LABEL f2
  199.   ON KEY LABEL shift-f1
  200.  
  201.   DO XT_TrmVars                  && Trim the vars from the form
  202.   lc_fullp = SET("FULLPATH")
  203.   SET FULLPATH ON
  204.  
  205.   gl_XIsCC = XT_MakExt()        && Make EXECCROS.PRG is needed
  206.   IF ll_f2
  207.     gc_xdbf = DBF()             && Capture open DBF file
  208.     DO XT_TrmVars                && Trim the vars from the form
  209.     SAVE TO crosstab ALL LIKE gc_x*
  210.     SET INSTRUCT OFF            && Prevent extra message when running app
  211.     SET SAFETY OFF
  212.  
  213.     IF FILE( "crosstab.qbe" )   && Delete the existing CROSSTAB.QBE file
  214.       ERASE crosstab.qbe
  215.     ENDIF
  216.  
  217.     RESTORE MACROS FROM ccboostr
  218.     PLAY MACRO SaveCros
  219. *-- Keystrokes in SaveCros macro file
  220. *     {Ctrl-y}{Enter}           && Clear Crosstab() out of skeleton
  221. *     {Alt-l}s                  && Layout menu, Save bar
  222. *     {Home}{Ctrl-y}            && Clear existing QBE name
  223. *     crosstab{Enter}           && Save as Crosstab.qbe
  224. *     {Ctrl-End}                && Exit QBE
  225. *     {rightarrow}{rightarrow}  && Cursor thru CC to Application panel
  226. *     {rightarrow}
  227. *     {rightarrow}
  228. *     execcros{Enter}           && Run ExecCros.PRG
  229. *     y                         && Confirm execution
  230. *-- End of keystroke macro file
  231.  
  232.   ELSE
  233.     IF .NOT. ll_escape
  234.       ll_edit = .F.
  235.       gc_xdbf = DBF()
  236.       DO XT_TrmVars              && Trim the vars from the form
  237.       SAVE TO crosstab ALL LIKE gc_x*
  238.     ENDIF
  239.     KEYBOARD CHR(kn_CtrlY)      && Remove the crosstab()
  240.     KEYBOARD CHR(kn_Enter)      && Restore skeleton for field
  241.   ENDIF
  242.  
  243.   DEACTIVATE WINDOW Crosstab
  244.   RELEASE WINDOW Crosstab
  245.   RELEASE POPUP crosstab
  246.  
  247.   RELEASE gc_xtitl,gc_xtop,gc_xside,gc_xsum,gc_xoper
  248.   RELEASE aa_lookup, params
  249.  
  250.   SET STATUS &lc_status.
  251.   SET CURSOR &lc_cursor.
  252.   SET ESCAPE &lc_escape.
  253.   SET SAFETY &lc_safety.
  254.   SET TALK &lc_talk.
  255.   SET FULLPATH &lc_fullp
  256.  
  257.   RESTORE SCREEN FROM qbe
  258.   RELEASE SCREEN qbe
  259. RETURN("")
  260. *-- EOF: CrossTab()
  261.  
  262. PROCEDURE XT_DisGets && UDS - CrossTab()
  263. *--------------------------------------------------------------------
  264. * Display the GET fields for the form.  Display the Navigation line
  265. * before starting the GET processing.  Allow Shift-F1 picklists
  266. * for the field selections.
  267. *--------------------------------------------------------------------
  268.   PRIVATE lc_errmsg
  269.   lc_errmsg = "Try again"
  270.  
  271. *-- Perform the GETs
  272.   @  2, 17 GET gc_xtitl  PICTURE "@S40";
  273.     MESSAGE "Specify an optional heading for the CrossTab display";
  274.     WHEN XT_NavDsp( 1 )
  275.  
  276.   @  4, 34 GET gc_xtop   PICTURE "@!S10" ;
  277.     MESSAGE "Specify the field to summarize along the top of the CrossTab";
  278.     WHEN XT_NavDsp( 2 );
  279.     VALID REQUIRED IsInView( gc_xtop ) .AND. TYPE( gc_xtop )<>"M";
  280.     ERROR IIF( TYPE(gc_xtop)="M",;
  281.                   "Memo fields are not allowed with CrossTab",;
  282.                   "The field specified is not in the current view")
  283.  
  284.  
  285.   @  9,  0 GET gc_xside  PICTURE "@!S10" ;
  286.     MESSAGE "Specify the field to summarize along the side of the CrossTab";
  287.     WHEN XT_NavDsp( 3 );
  288.     VALID REQUIRED IsInView( gc_xside ) .AND. TYPE( gc_xside )<>"M";
  289.     ERROR IIF( TYPE(gc_xside)="M",;
  290.                   "Memo fields are not allowed with CrossTab",;
  291.                   "The field specified is not in the current view")
  292.  
  293.   @  8, 34 GET gc_xsum   PICTURE "@!S10" ;
  294.     MESSAGE "Specify the field to operate on in the body of the CrossTab";
  295.     WHEN XT_NavDsp( 4 );
  296.     VALID REQUIRED IsInView( gc_xsum ) .AND. TYPE( gc_xsum )<>"M";
  297.     ERROR IIF( TYPE(gc_xsum)="M",;
  298.                   "Memo fields are not allowed with CrossTab",;
  299.                   "The field specified is not in the current view")
  300.  
  301. ** Error message below changed to reflect new options.  JP
  302.  
  303.   @ 10, 39 GET gc_xoper  PICTURE ( gc_actlist ) ;
  304.     MESSAGE "Specify the operation on the summary field";
  305.     WHEN XT_NavDsp( 5 ) ;
  306.     VALID REQUIRED ( TYPE( gc_xsum ) = "C" .AND. ;
  307.                      gc_xoper <> "SUM"             ) .OR. ;
  308.                    ( TYPE( gc_xsum ) = "L" .AND. ;
  309.                      gc_xoper = "CNT" ) .OR.;
  310.                      TYPE( gc_xsum ) $ "NFD";
  311.     ERROR IIF( TYPE( gc_xsum ) = "C", ;
  312.                   "SUM, AVG, STD and VAR require numeric fields", ;
  313.                   "while CNT alone may be used with logical fields")
  314. **                "SUM can not be used with character fields", ;
  315. **                "MAX, MIN, or SUM can not be used with logical fields")
  316.  
  317. RETURN
  318. *-- EOP: XT_DisGets
  319.  
  320. PROCEDURE Com_XTab  && Compute CrossTab Based on Parameters
  321. PARAMETERS p_topfld, p_sidfld, p_calfld, p_calc
  322. *------------------------------------------------------------------
  323. * Compute data normalized form of a relational database 
  324. * file to a spreadsheet-like structure.  It summarizes the 
  325. * data in one field by expressing it in terms of two other 
  326. * fields.
  327. * 
  328. * SYNTAX 
  329. * 
  330. * DO Com_XTab WITH <top field name>, <side field name>, ;
  331. *                  <calc field>, <type calc>
  332. * 
  333. * where <type calc> can be one of the following functions:
  334. * 
  335. *   CNT
  336. *   MAX
  337. *   MIN
  338. *   SUM
  339. **      Functions added by JP
  340. **  AVG        && average
  341. **  STD        && population standard deviation
  342. **  VAR        && population variance
  343. * 
  344. * USAGE
  345. * 
  346. * The Com_XTab command handles all records in the active 
  347. * file that match any filter condition placed on the data.
  348. * Com_XTab places the result of the CROSSTAB in a file
  349. * named CROSSTAB.  Com_XTab will also place the column names
  350. * for the <top field name> in a file named COLUMNS.  
  351. * Com_XTab will overwrite these files.
  352. **
  353. **  Comments added by JP
  354. **
  355. **  When using AVG, STD or VAR, the procedure adds a file,
  356. **  N_XTAB.DBF, to hold the number of occurrences of the same
  357. **  combination of top and side fields.
  358. **
  359. **  When using STD or VAR, the procedure adds a third file,
  360. **  SQ_XTAB.DBF, to hold the sum of the squares of the data.
  361. **
  362. **  Com_XTab will overwrite these files too.
  363. * 
  364. * OPTIONS
  365. * 
  366. * CNT counts the records that match the <top field name>
  367. * and the <side field name>.
  368. * 
  369. * SUM adds together the values of <calc field> that match
  370. * the <top field name> and the <side field name>.
  371. * 
  372. * MAX determines the maximum value of <calc field> for
  373. * matching values of <top field name> and <side field name>.
  374. * 
  375. * MIN determines the minimum value of <calc field> for
  376. * matching values of <top field name> and <side field name>.
  377. * 
  378. ** Comments added by JP
  379. **
  380. ** AVG averages the values of <calc field> that match the values
  381. ** of <top field name> and <side field name>.
  382. **
  383. ** STD calculates the population standard deviation of the values
  384. ** of <calc field> that match the <top field name> and <side field
  385. ** name>, the square root of VAR.
  386. **
  387. ** VAR calculates the population variance of the values of <calc field>
  388. ** that match the <top field name> and <side field name>.
  389. **
  390. ** If there are no occurrences, the AVG,STD and VAR are (meaninglessly)
  391. ** reported as zero to save the time of creating a file with
  392. ** character fields, copying the real averages to it as strings
  393. ** and filling other fields with blanks.  Zero-occurrence fields
  394. ** are not counted in the summary totals.
  395. **
  396. * EXAMPLE
  397. * 
  398. * Consider the following database file.
  399. * 
  400. * CAMPING   Name  Item     Price
  401. * -------   ----  -----   ------
  402. *     1     John  Tent    245.00
  403. *     2     Mark  Stove    59.00
  404. *     3     Jane  Heater   75.00
  405. *     4     Mark  Stove    79.00
  406. *     5     Jane  Heater   95.00
  407. *     6     Jane  Tent    325.00
  408. *     7     John  Tent    175.00
  409. *     8     Mark  Stove    89.00
  410. * 
  411. * DO Com_XTab WITH "Item", "Name", "Price", "SUM"
  412. * 
  413. *   will create the following two files:
  414. * 
  415. * CROSSTAB  Name   COL01   COL02   COL03
  416. * --------  ----  ------  ------  ------
  417. *     1     Jane  170.00    0.00  325.00  
  418. *     2     John    0.00    0.00  420.00
  419. *     3     Mark    0.00  227.00    0.00
  420. * 
  421. * The CROSSTAB file will be active in work area 1.
  422. *
  423. * COLUMNS   Column  TopField
  424. * -------   ------  --------
  425. *     1     COL01   Heater
  426. *     2     COL02   Stove
  427. *     3     COL03   Tent
  428. * 
  429. * The COLUMNS file will be open in work area 2.  The COLUMNS
  430. * file will have an MDX TAG Column on the Column field.  
  431. * 
  432. **
  433. ** Comments by JP
  434. ** As modified, the Crosstab file will also contain a field and a
  435. ** record summarizing the data in that row and column, and another
  436. ** undisplayed field "SEQ" used to keep it in order for display.
  437. ** The N_XTab aand SQ_XTab files, if created, share the structure of
  438. ** Crosstab and map directly to it by row and column; they basically
  439. ** add a third dimension to hold values needed for their calculations.
  440. **
  441. * COM_XTAB will create a SET FIELDS TO command for each column
  442. * based on the Columns file to get the correct column heading.
  443. * This technique will only work if the resulting column name
  444. * is less than or equal to 10 characters and it contains
  445. * no punctuation or spaces.
  446. * 
  447. * You may use this file in the report designer to place a 
  448. * meaningfull column label for a report.  Before entering
  449. * the report designer execute the command:
  450. *     SET FIELDS TO <Enter>
  451. * 
  452. * SEE ALSO
  453. * 
  454. *------------------------------------------------------------------
  455.  
  456. *-- Save the current environment
  457.   SET FILTER TO                 && Clear the filter condition if any
  458.   PRIVATE lc_talk
  459.   IF SET("TALK") = "ON"         && Set talk off, but restore it later
  460.     SET TALK OFF
  461.     lc_talk = "ON"
  462.   ELSE
  463.     lc_talk = "OFF"
  464.   ENDIF
  465.  
  466.   PRIVATE lc_safety
  467.   lc_safety = SET("SAFETY")     && Save the SAFETY state
  468.   SET SAFETY OFF                && and turn it off.
  469.  
  470.   PRIVATE lc_excl
  471.   lc_excl = SET("EXCLUSIVE")    && Save the EXCLUSIVE state
  472.   SET EXCLUSIVE ON              && and turn it on.
  473.  
  474.   PRIVATE lc_status
  475.   lc_status = SET("STATUS")     && Save the status bar before turning it off
  476.   SET STATUS OFF
  477.  
  478.   SET CURSOR OFF
  479.   lc_stat1 = "Determining the number of UNIQUE Records"
  480.   lc_stat2 = "Creating CROSSTAB and COLUMNS DBF files "
  481.   lc_stat3 = "Populating the COLUMNS file             "
  482.   lc_stat4 = "Populating the CROSSTAB file            "
  483.   lc_stat5 = "Creating Pseudo Field Headings          "
  484.   DEFINE WINDOW com_xtab FROM 5,9 TO 13, 70
  485.   DO ShadowG WITH 5, 9, 13, 70
  486.   ACTIVATE WINDOW com_xtab
  487.  
  488.   @ 0, 20 SAY "Computing CrossTab"
  489.   @ 2, 5 SAY lc_stat1 + + CHR(205) + CHR(205) + CHR(16)
  490.   @ 2, 50 SAY "Working"
  491.  
  492. *-- Make sure a data file is open
  493.   IF Empty( ALIAS() )
  494.     lc_error = XT_ErrMsg( "No file is in use!", "" )
  495.     DO XT_RestEv
  496.     CANCEL
  497.   ENDIF   
  498.  
  499. *-- Preserve the order of the file going into crosstab
  500.   lc_order = ORDER()
  501.  
  502. ** Following 3 routines mostly commented out and replaced by JP due to
  503. ** surpassing ugliness of original code.
  504. ** Yeah, I know, these guys worked hard and I shouldn't knock it if it
  505. ** works.  But sometimes, I can't resist.
  506.  
  507. *-- Strip the alias from the field if it exists
  508.    ln_apos   = AT( "->", p_topfld )  && Alias position, optional
  509. *  IF ln_apos > 0                    && Alias exists, now get the field
  510. *    lc_ptopfld = SUBSTR( p_topfld, ln_apos + 2, LEN( p_topfld ) - ln_apos )
  511. *  ELSE
  512. *    lc_ptopfld = UPPER( p_topfld )
  513. *  ENDIF
  514.    lc_ptopfld = upper(iif(ln_apos=0,p_topfld,substr(p_topfld,ln_apos+2)))
  515.  
  516.    ln_apos   = AT( "->", p_sidfld )  && Alias position, optional
  517. *  IF ln_apos > 0                    && Alias exists, now get the field
  518. *    lc_psidfld = SUBSTR( p_sidfld, ln_apos + 2, LEN( p_sidfld ) - ln_apos )
  519. *  ELSE
  520. *    lc_psidfld = UPPER( p_sidfld )
  521. *  ENDIF
  522.    lc_psidfld = upper(iif(ln_apos=0,p_sidfld,substr(p_sidfld,ln_apos+2)))
  523.  
  524.    ln_apos   = AT( "->", p_calfld )  && Alias position, optional
  525. *  IF ln_apos > 0                    && Alias exists, now get the field
  526. *    lc_pcalfld = SUBSTR( p_calfld, ln_apos + 2, LEN( p_calfld ) - ln_apos )
  527. *  ELSE
  528. *    lc_pcalfld = UPPER( p_calfld )
  529. *  ENDIF
  530.    lc_pcalfld = upper(iif(ln_apos=0,p_calfld,substr(p_calfld,ln_apos+2)))
  531.  
  532. *-- Make sure the fields exist in the current file
  533. *-- Already checked in CrossTab()
  534. *-----------------------------------------------------------------------
  535. NOTE   IF .NOT. XT_isfld( lc_ptopfld )
  536. NOTE     lc_error = XT_ErrMsg( "Top field: " + lc_ptopfld + ;
  537. NOTE                          " is not in the file", "" )
  538. NOTE     DO XT_RestEv
  539. NOTE     RETURN
  540. NOTE   ENDIF
  541. NOTE 
  542. NOTE   IF .NOT. XT_isfld( lc_psidfld )
  543. NOTE     lc_error = XT_ErrMsg( "Side field: " + lc_psidfld + ;
  544. NOTE                          " is not in the file", "" )
  545. NOTE     DO XT_RestEv
  546. NOTE     RETURN
  547. NOTE   ENDIF
  548. NOTE 
  549. NOTE   IF .NOT. XT_isfld( lc_pcalfld )
  550. NOTE     lc_error = XT_ErrMsg( "Calculated field: " + lc_pcalfld + ;
  551. NOTE                          " is not in the file", "" )
  552. NOTE     DO XT_RestEv
  553. NOTE     RETURN
  554. NOTE   ENDIF
  555. *-----------------------------------------------------------------------
  556.  
  557. *-- Verify the calculation type
  558. ** Types added by JP.  Hey!  How did AVG get in the original?
  559. * IF .NOT. p_calc $ "SUM,CNT,MAX,MIN,AVG"
  560.   IF .NOT. p_calc $ "SUM,CNT,MAX,MIN,AVG,STD,VAR"
  561.     lc_error = XT_ErrMsg( "Calculation type: " + p_calc + ;
  562.                          " is not supported!", "" )
  563.     DO XT_RestEv
  564.     CANCEL
  565.   ENDIF
  566.  
  567. *-- Compute the number of top and side values
  568.   lc_typetop = TYPE( lc_ptopfld )
  569.   DO CASE
  570.     CASE lc_typetop = "L"
  571.       INDEX ON IIF( &lc_ptopfld., "T", "F" ) TAG topfld UNIQUE
  572.     CASE lc_typetop = "C"
  573.       INDEX ON UPPER( &lc_ptopfld. ) TAG topfld UNIQUE
  574.     CASE lc_typetop $ "NF"
  575.       INDEX ON &lc_ptopfld. TAG topfld UNIQUE
  576.     CASE lc_typetop = "D"
  577.       INDEX ON DTOS( &lc_ptopfld. ) TAG topfld UNIQUE
  578.   ENDCASE
  579.  
  580.   COUNT TO ln_columns
  581.   IF ln_columns > 254
  582.     lc_error = XT_ErrMsg( "Unique columns for the top exceeds 254", "")
  583.     DELETE TAG topfld
  584.     DO XT_RestEv
  585.     CANCEL
  586.   ENDIF
  587.  
  588.   lc_typesid = TYPE( lc_psidfld )
  589.   DO CASE
  590.     CASE lc_typesid = "L"
  591.       INDEX ON IIF( &lc_psidfld., "T", "F" ) TAG sidfld UNIQUE
  592.     CASE lc_typesid = "C"
  593.       INDEX ON UPPER( &lc_psidfld. ) TAG sidfld UNIQUE
  594.     CASE lc_typesid $ "NF"
  595.       INDEX ON &lc_psidfld. TAG sidfld UNIQUE
  596.     CASE lc_typesid = "D"
  597.       INDEX ON DTOS( &lc_psidfld. ) TAG sidfld UNIQUE
  598.   ENDCASE
  599.  
  600.   COUNT TO ln_rows
  601.  
  602.   @ 2, 50 SAY "Complete"
  603.   @ 3, 5 SAY lc_stat2 + + CHR(205) + CHR(205) + CHR(16)
  604.   @ 3, 50 SAY "Working"
  605.  
  606. *-- Create the CROSSTAB file to hold the values
  607.   COPY TO _cross STRUCTURE EXTENDED
  608.   SELECT SELECT()
  609.   USE _cross        
  610.  
  611. *-- Make the calc field's attributes global for use in the SET FIELDS TO
  612. *-- command after the crosstab is created to adjust the column size.
  613.   IF TYPE( "gn_dec" ) <> "U"
  614.     RELEASE gn_dec
  615.   ENDIF
  616.   PUBLIC gn_dec
  617.   IF TYPE( "gn_len" ) <> "U"
  618.     RELEASE gn_len
  619.   ENDIF
  620.   PUBLIC gn_len
  621.  
  622. *-- Get the attributes for the side field
  623.   LOCATE FOR field_name = UPPER( lc_psidfld )
  624.   ln_lensid = field_len
  625.   ln_decsid = field_dec
  626.  
  627. *-- Get the attributes for the top field
  628.   LOCATE FOR field_name = UPPER( lc_ptopfld )
  629.   ln_lentop = field_len
  630.   ln_dectop = field_dec
  631.  
  632. *-- Get the attributes for the calculated column
  633.   LOCATE FOR field_name = UPPER( lc_pcalfld )
  634.   IF p_calc = "CNT"
  635.     gn_len = LEN( ALLTRIM( RECCOUNT() ) )
  636.     gn_dec = 0
  637.   ELSE
  638.     gn_len = field_len
  639.     IF p_calc = "SUM" .AND. gn_len < 16   && Adjust column length if SUM
  640.       gn_len = gn_len + 2
  641.     ENDIF
  642.     gn_dec = field_dec
  643.   ENDIF
  644.   ZAP
  645.  
  646. *----------------------------------------------------------------------
  647. *-- Create the CROSSTAB file fields
  648. *----------------------------------------------------------------------
  649. *-- Make the Side Column column
  650.   APPEND BLANK
  651. **  Changed to type "C", length minimum 7 - easier to deal with labels JP
  652.   REPLACE field_name WITH lc_psidfld, ;
  653.           field_type WITH "C", ;
  654.           field_len  WITH max( ln_lensid, 7 ) , ;
  655.           field_dec  WITH 0 , ;
  656.           field_idx  WITH "N"
  657. *         field_type WITH IIF( lc_typesid = "L", "C", lc_typesid ), ;
  658. *         field_len  WITH ln_lensid) , ;
  659. *         field_dec  WITH ln_decsid ,  ;
  660.  
  661. *-- Make the crosstab columns
  662.   ln_col = 1                      && Counter for creating columns
  663.   DO WHILE ln_col <= ln_columns
  664.     lc_colname = "COL" + SUBSTR( STR( 100 + ln_col, 3, 0), 2, 2 )
  665.     APPEND BLANK
  666.     REPLACE field_name WITH lc_colname, ;
  667.             field_type WITH "N"       , ;
  668.             field_len  WITH gn_len    , ;
  669.             field_dec  WITH gn_dec    , ;
  670.             field_idx  WITH "N"
  671.  
  672.     ln_col = ln_col + 1           && Increment column counter
  673.   ENDDO
  674.  
  675. **-- Make the summary column.  Added by JP
  676. **   If you don't want summary column, take this section out.
  677.   APPEND BLANK
  678.   lc_rtcol = "Z" + replicate( "_", gn_len - 1 ) && last possible name
  679.   REPLACE field_name WITH lc_rtcol, ;
  680.           field_type WITH "N"  , ;
  681.           field_len  WITH gn_len,;
  682.           field_dec  WITH gn_dec,;
  683.           field_idx  WITH "N"
  684.  
  685. **  Sequence field added to enable renaming bottom record without
  686. **  index causing it to move JP - needed only for summaries
  687.    APPEND BLANK
  688.    REPLACE field_name WITH "Seq", ;
  689.           field_type WITH "N",    ;
  690.           field_len  WITH int( log10( ln_rows + 1 ) ) + 1,;
  691.           field_dec  WITH 0,      ;
  692.           field_idx  WITH "N"
  693.  
  694.    IF p_calc $ "STD,VAR"
  695.      COPY TO _cross2
  696.    ENDIF
  697.  
  698.  ** back to original code
  699.  
  700.   CREATE crosstab FROM _cross
  701.   USE crosstab ALIAS crosstab
  702.  
  703.   INDEX ON UPPER( &lc_psidfld ) TAG &lc_psidfld
  704.  
  705. *----------------------------------------------------------------------
  706. *-- Make the COLUMN file fields
  707. *----------------------------------------------------------------------
  708.   SELECT SELECT()
  709.   USE _cross
  710.   ZAP
  711.   APPEND BLANK
  712.   REPLACE field_name WITH "COLUMN", ;
  713.           field_type WITH "C"     , ;
  714.           field_len  WITH 5       , ;
  715.           field_dec  WITH 0       , ;
  716.           field_idx  WITH "Y"
  717.   APPEND BLANK            
  718.   REPLACE field_name WITH lc_ptopfld, ;
  719.           field_type WITH "C"       , ;
  720.           field_len  WITH ln_lentop , ;
  721.           field_dec  WITH 0         , ;
  722.           field_idx  WITH "N"
  723.                        
  724.   CREATE columns FROM _cross
  725.   USE columns ALIAS columns
  726.   INDEX ON UPPER( &lc_ptopfld ) TAG &lc_ptopfld
  727.  
  728.   @ 3, 50 SAY "Complete"
  729.   @ 4, 5 SAY lc_stat3 + + CHR(205) + CHR(205) + CHR(16)
  730.   @ 4, 50 SAY "Working"
  731.  
  732. *-- Fill in the column file with the UNIQUE values for the top fields
  733. *-- from the source DBF
  734.   SELECT 1
  735.   SET ORDER TO TAG topfld
  736.   ln_col = 1
  737.   SCAN      
  738.     lc_colname =  "COL" + SUBSTR( STR( 100 + ln_col, 3, 0), 2, 2 )
  739.     SELECT columns
  740.     APPEND BLANK
  741.     DO CASE 
  742.       CASE lc_typetop = "C"
  743.         REPLACE column      WITH lc_colname, ;
  744.                 &lc_ptopfld WITH &p_topfld
  745.       CASE lc_typetop = "L"
  746.         REPLACE column      WITH lc_colname, ;
  747.                 &lc_ptopfld WITH IIF( &p_topfld., "T", "F" )
  748.       CASE lc_typetop $ "NF"
  749.         REPLACE column      WITH lc_colname, ;
  750.                 &lc_ptopfld WITH ;
  751.                   ALLTRIM( STR( &p_topfld, ln_lentop, ln_dectop ) )
  752.       CASE lc_typetop = "D"
  753.         REPLACE column      WITH lc_colname, ;
  754.                 &lc_ptopfld WITH DTOC( &p_topfld. )
  755.     ENDCASE
  756.  
  757.     ln_col = ln_col + 1
  758.     SELECT 1
  759.   ENDSCAN
  760.                                                          
  761. *-- Initialize the crosstab matrix by filling in the side column
  762. *-- with the UNIQUE values from the source DBF
  763. *-- This two pass approach is no faster than filling it in as
  764. *-- the crosstab function is populated.  It has the added advantage
  765. *-- of correctly ordering the side column.
  766.   SELECT 1
  767.   SET ORDER TO TAG sidfld
  768. ** line added for indexing value
  769.   ln_ordno = 1
  770.   SCAN
  771.     SELECT crosstab
  772.     APPEND BLANK
  773. ** Type changed to character for use with summaries JP
  774.     DO CASE
  775.       CASE lc_typesid = "C"
  776.         lc_colname = &p_sidfld
  777.       CASE lc_typesid = "L"
  778.         lc_colname = iif( &p_sidfld., "T", "F" )
  779.       CASE lc_typesid $ "NF"
  780.         lc_colname = str( &p_sidfld., ln_lensid, ln_decsid )
  781.       CASE lc_typesid = "D"
  782.         lc_colname = dtos( &p_sidfld )        && we want date order
  783.      ENDCASE
  784.      REPLACE &lc_psidfld WITH lc_colname
  785. *    REPLACE &lc_psidfld WITH ;
  786. *            IIF(lc_typesid = "L", ;
  787. *                IIF( &p_sidfld, "T", "F" ),;
  788. *                &p_sidfld ;
  789. *            )
  790. ** Also add sequential number for use with summaries
  791.      REPLACE Seq WITH ln_ordno
  792.      ln_ordno = ln_ordno + 1
  793. ** end this change
  794.  
  795.     SELECT 1
  796.   ENDSCAN
  797.  
  798. ** add a blank record for summary row, last in order JP
  799. ** again, this affects only addition of summary row & col
  800.   SELECT crosstab
  801.   lc_botrow = "Z" + replicate( "_", ln_lensid - 1 )
  802.   APPEND BLANK
  803.   REPLACE &lc_psidfld WITH lc_botrow, Seq WITH ln_ordno
  804.  
  805. ** Added by JP -- make auxiliary files like Crosstab, in same order
  806. ** Needed for new operations, regardless of summaries in or out
  807.   IF p_calc $ "AVG,STD,VAR"
  808.     SET ORDER TO
  809.     COPY TO N_XTAB
  810.     USE N_XTAB ALIAS Number IN select()
  811.     INDEX ON UPPER( &lc_psidfld ) TAG &lc_psidfld
  812.     SET ORDER TO TAG &lc_psidfld
  813.     IF p_calc # "AVG"
  814. ** file for squares needs longer fields to hold possible digits
  815.       SELECT crosstab
  816.       USE _cross2
  817.       GOTO 2
  818.       SCAN WHILE recno() < reccount() - 1
  819.         REPLACE field_len WITH min( gn_len * gn_len, 20 )
  820.       ENDSCAN
  821.       GO reccount() - 1
  822.       REPLACE field_len WITH min( gn_len * gn_len + 2, 20 )
  823.       CREATE SQ_XTAB FROM _cross2
  824.       APPEND FROM crosstab
  825.       USE
  826.       USE SQ_XTAB ALIAS Squares
  827.       INDEX ON UPPER( &lc_psidfld ) TAG &lc_psidfld
  828.       SET ORDER TO TAG &lc_psidfld
  829.       USE crosstab ALIAS crosstab IN select()
  830.     ENDIF
  831.     SELECT crosstab
  832.     SET ORDER TO TAG &lc_psidfld
  833.     SELECT 1
  834.   ENDIF
  835. ** end of additions by JP
  836.  
  837.   @ 4, 50 SAY "Complete"
  838.   @ 5, 5 SAY lc_stat4 + + CHR(205) + CHR(205) + CHR(16)
  839.   @ 5, 50 SAY "Working"
  840.  
  841. *-- Compute the matrix - brute force
  842.   SELECT 1
  843.   SET ORDER TO &lc_order          && Return to the original order
  844. *                                 && in the event a FOR condition was
  845. *                                 && placed on the index.
  846.                                                                
  847.   SET FILTER TO &gc_filter
  848.   SCAN
  849. **  Type changed to character JP
  850.     DO CASE
  851.       CASE lc_typesid = "C"
  852.         l_seekval = upper( &lc_psidfld )
  853.       CASE lc_typesid = "L"
  854.         l_seekval = IIF( &lc_psidfld., "T", "F" )
  855.       CASE lc_typesid $ "NF"
  856.         l_seekval = str( &lc_psidfld., ln_lensid, ln_decsid )
  857.       CASE lc_typesid = "D"
  858.         l_seekval = dtos( &p_sidfld )
  859.      ENDCASE
  860.  
  861. *   IF lc_typesid = "L"
  862. *     l_seekval = IIF( &lc_psidfld., "T", "F" )
  863. *   ELSE
  864. *     IF lc_typesid = "C"
  865. *       l_seekval = UPPER( &lc_psidfld )
  866. *     ELSE
  867. *       l_seekval = &lc_psidfld
  868. *     ENDIF
  869. *   ENDIF
  870. ** end this change
  871.  
  872.     IF SEEK( l_seekval, "crosstab" )
  873.  
  874.       DO CASE
  875.         CASE lc_typetop = "C"
  876.           l_seekval = UPPER( &lc_ptopfld )
  877.         CASE lc_typetop = "L"
  878.           l_seekval = IIF( &lc_ptopfld., "T", "F" )
  879.         CASE lc_typetop $ "NF"
  880.           l_seekval = ALLTRIM( STR( &lc_ptopfld, ln_lentop, ln_dectop ) )
  881.         CASE lc_typetop = "D"
  882.           l_seekval = DTOC( &lc_ptopfld )
  883.       ENDCASE
  884.  
  885.       IF SEEK( l_seekval, "columns" )
  886.         lc_colname = columns->column
  887.         DO CASE
  888. ** Changed by JP, new operations
  889. *         CASE p_calc = "SUM"
  890.           CASE p_calc $ "SUM,AVG,STD,VAR"
  891. ** end change
  892.             REPLACE crosstab->&lc_colname WITH ;
  893.                     &p_calfld + crosstab->&lc_colname
  894. ** Added by JP, ditto
  895.             IF p_calc # "SUM"
  896.               SELECT Number
  897.               GO recno("crosstab")
  898.               REPLACE &lc_colname WITH &lc_colname + 1
  899.               IF p_calc $ "STD,VAR"
  900.                 SELECT Squares
  901.                 GO recno("crosstab")
  902.                 REPLACE &lc_colname WITH &lc_colname + ;
  903.                   &p_calfld * &p_calfld
  904.               ENDIF STD or VAR
  905.               SELECT 1
  906.             ENDIF AVG, STD or VAR
  907. ** End of additions JP
  908.           CASE p_calc = "CNT"
  909.             REPLACE crosstab->&lc_colname WITH ;
  910.                     1 + crosstab->&lc_colname
  911.           CASE p_calc = "MAX"
  912.             REPLACE crosstab->&lc_colname WITH ;
  913.                     MAX( &p_calfld, crosstab->&lc_colname )
  914.           CASE p_calc = "MIN"
  915.             IF crosstab->&lc_colname = 0
  916.               REPLACE crosstab->&lc_colname WITH &p_calfld
  917.             ELSE
  918.               REPLACE crosstab->&lc_colname WITH ;
  919.                       MIN( &p_calfld, crosstab->&lc_colname )
  920.             ENDIF
  921.         ENDCASE
  922.       ENDIF
  923.  
  924.     ENDIF
  925.  
  926.   ENDSCAN
  927.  
  928. ** Next long section added by JP
  929.  
  930. ** Do row and column summaries.
  931. ** In the same pass, use the extra tables to do AVG,STD and VAR calculations
  932. ** and place them in the Crosstab file.
  933.  
  934. ** If you don't want summaries, remove this section
  935.   DECLARE ln_tarray [ln_columns + 2]     && a variable per column of data
  936.   IF p_calc $ "AVG,STD,VAR"              && including summary and unused side
  937.     DECLARE ln_narray[ln_columns + 2]    && column for each table
  938.     IF p_calc # "AVG"
  939.       DECLARE ln_sqarray[ln_columns + 2]
  940.     ENDIF
  941.   ENDIF
  942.   ln_col = 2                         && first column is side field names
  943.   DO WHILE ln_col <= ln_columns + 2  && initialize summary column too
  944.     STORE 0 TO ln_tarray[ ln_col ]   && initialize at 0
  945.     IF p_calc $ "AVG,STD,VAR"
  946.       STORE 0 TO ln_narray[ ln_col ]
  947.       IF p_calc # "AVG"
  948.         STORE 0 TO ln_sqarray[ ln_col ]
  949.       ENDIF
  950.     ENDIF
  951.     ln_col = ln_col + 1
  952.   ENDDO
  953. ** end of part that may be removed if removing summaries
  954.  
  955.   SELECT crosstab
  956.   SCAN                               && for each record
  957.  
  958. ** take out all this if removing summaries
  959.     IF recno() = reccount()          && except the last, which is totals
  960.       EXIT
  961.     ENDIF
  962. ** end of removable part
  963.  
  964.     ln_col = 2
  965.     DO WHILE ln_col <= ln_columns + 1 && for each field except summary
  966.       lc_col = field( ln_col )
  967.  
  968. ** remove next part too for no summaries
  969.       DO CASE
  970.         CASE p_calc $ "CNT,SUM"
  971.           ln_tarray[ ln_col ] = ln_tarray[ ln_col ] + &lc_col
  972.           ln_tarray[ ln_columns + 2 ] = ln_tarray[ ln_columns + 2 ] + &lc_col
  973.         CASE p_calc = "MAX"
  974.           ln_tarray[ ln_col ] = max( ln_tarray[ ln_col ], &lc_col )
  975.           ln_tarray[ ln_columns + 2 ] = ;
  976.               max( ln_tarray[ ln_columns + 2 ], &lc_col )
  977.         CASE p_calc = "MIN"
  978.           ln_tarray[ ln_col ] = min( ln_tarray[ ln_col ], &lc_col )
  979.           ln_tarray[ ln_columns + 2 ] = ;
  980.               min( ln_tarray[ ln_columns + 2 ], &lc_col )
  981.         OTHERWISE
  982. ** to here
  983.           SELECT Number
  984.           GO recno( "crosstab" )
  985.           ln_num = &lc_col
  986.           SELECT crosstab
  987.           IF ln_num = 0
  988.             REPLACE &lc_col WITH 0     && and don't count it
  989.           ELSE
  990. ** and remove from here
  991.             ln_tarray[ ln_col ] = ln_tarray[ ln_col ] + &lc_col
  992.             ln_tarray[ ln_columns + 2 ] = ln_tarray[ ln_columns + 2 ] + &lc_col
  993.             ln_narray[ ln_col ] = ln_narray[ ln_col ] + ln_num
  994.             ln_narray[ ln_columns + 2 ] = ln_narray[ ln_columns + 2 ] + ln_num
  995. ** to here
  996.             IF p_calc = "AVG"
  997.               REPLACE &lc_col WITH &lc_col / ln_num
  998.             ELSE
  999.               SELECT Squares
  1000.               GO recno( "crosstab" )
  1001.               ln_sq = &lc_col
  1002.               SELECT crosstab
  1003. ** and next two
  1004.               ln_sqarray[ ln_col ] = ln_sqarray[ ln_col ] + ln_sq
  1005.               ln_sqarray[ ln_columns + 2 ] = ;
  1006.                 ln_sqarray[ ln_columns + 2 ] + ln_sq
  1007. ** down to here
  1008.               ln_var = ( ln_sq - &lc_col * &lc_col / ln_num ) / ln_num
  1009.               REPLACE &lc_col WITH iif( p_calc = "VAR", ln_var, sqrt( ln_var ) )
  1010.             ENDIF STD or VAR
  1011.           ENDIF zero occurrences
  1012. ** and there won't be a case if no summaries so take out next line
  1013.       ENDCASE
  1014.  
  1015.       ln_col = ln_col + 1
  1016.     ENDDO
  1017.  
  1018. ** this all goes out too for no summaries
  1019.     IF p_calc $ "AVG,STD,VAR"
  1020.       SELECT Number
  1021.       GO recno( "crosstab" )
  1022.       REPLACE &lc_rtcol WITH ln_narray[ ln_columns + 2 ]
  1023.       SELECT crosstab
  1024.       IF ln_narray[ ln_columns + 2 ] = 0
  1025.         REPLACE &lc_rtcol WITH 0
  1026.       ELSE
  1027.         IF p_calc = "AVG"
  1028.           REPLACE &lc_rtcol WITH ln_tarray[ ln_columns + 2 ] ;
  1029.              / ln_narray[ ln_columns + 2 ]
  1030.         ELSE
  1031.           SELECT Squares
  1032.           GO recno( "crosstab" )
  1033.           REPLACE &lc_rtcol WITH ln_sqarray[ ln_columns + 2 ]
  1034.           SELECT crosstab
  1035.           ln_var = ( ln_sqarray[ ln_columns + 2 ] -  ;
  1036.                      ln_tarray[ ln_columns + 2 ] *   ;
  1037.                      ln_tarray[ ln_columns + 2 ] /   ;
  1038.                      ln_narray[ ln_columns + 2 ] ) / ;
  1039.                      ln_narray[ ln_columns + 2 ]
  1040.           REPLACE &lc_rtcol WITH iif(p_calc = "VAR", ln_var, sqrt( ln_var ))
  1041.           ln_sqarray[ ln_columns + 2 ] = 0
  1042.         ENDIF AVG
  1043.       ENDIF 0 or not
  1044.       ln_narray[ ln_columns + 2] = 0
  1045.     ELSE
  1046.       REPLACE &lc_rtcol WITH ln_tarray[ ln_columns + 2 ]
  1047.     ENDIF AVG, STD or VAR
  1048.     ln_tarray[ ln_columns + 2 ] = 0
  1049. ** next line has to stay in
  1050.   ENDSCAN
  1051.  
  1052. ** Already at bottom record of crosstab - record column "totals"
  1053. ** take out all the rest of the added routine for no summaries
  1054.  
  1055.   ln_col = 2
  1056.   DO WHILE ln_col <= ln_columns + 1
  1057.     lc_col = field( ln_col )
  1058.     IF p_calc $ "SUM,CNT,MAX,MIN"
  1059.       REPLACE &lc_col WITH ln_tarray[ ln_col ]
  1060.       DO CASE
  1061.         CASE p_calc $ "SUM,CNT"
  1062.           ln_tarray[ ln_columns + 2 ] = ;
  1063.             ln_tarray[ ln_columns + 2 ] + ln_tarray[ ln_col ]
  1064.         CASE p_calc = "MAX"
  1065.           ln_tarray[ ln_columns + 2 ] = ;
  1066.             max( ln_tarray[ ln_columns + 2 ], ln_tarray[ ln_col ] )
  1067.         OTHERWISE
  1068.           ln_tarray[ ln_columns + 2 ] = ;
  1069.             min( ln_tarray[ ln_columns + 2 ], ln_tarray[ ln_col ] )
  1070.       ENDCASE
  1071.     ELSE
  1072.       IF ln_narray[ ln_col ] = 0
  1073.         REPLACE &lc_col WITH 0
  1074.       ELSE
  1075.         ln_tarray[ ln_columns + 2 ] = ;
  1076.           ln_tarray[ ln_columns + 2 ] + ln_tarray[ ln_col ]
  1077.         SELECT Number
  1078.         GO recno( "crosstab" )
  1079.         REPLACE &lc_col WITH ln_narray[ ln_col ]
  1080.         ln_narray[ ln_columns + 2 ] = ;
  1081.           ln_narray[ ln_columns + 2 ] + ln_narray[ ln_col ]
  1082.         IF p_calc = "AVG"
  1083.           SELECT crosstab
  1084.           REPLACE &lc_col WITH ln_tarray[ ln_col ] / ln_narray[ ln_col ]
  1085.         ELSE
  1086.           SELECT Squares
  1087.           GO recno( "crosstab" )
  1088.           REPLACE &lc_col WITH ln_sqarray[ ln_col ]
  1089.           ln_sqarray[ ln_columns + 2 ] = ;
  1090.             ln_sqarray[ ln_columns + 2 ] + ln_sqarray[ ln_col ]
  1091.           ln_var = ( ln_sqarray[ ln_col ] - ;
  1092.                      ln_tarray[ ln_col ] *   ;
  1093.                      ln_tarray[ ln_col ] /   ;
  1094.                      ln_narray[ ln_col ] ) / ;
  1095.                      ln_narray[ ln_col ]
  1096.           SELECT crosstab
  1097.           REPLACE &lc_col WITH iif( p_calc = "VAR", ln_var, sqrt( ln_var ) )
  1098.         ENDIF not AVG
  1099.       ENDIF zero occurrences
  1100.     ENDIF easy operations
  1101.     ln_col = ln_col + 1
  1102.   ENDDO
  1103.  
  1104. * Grand "total"
  1105.   DO CASE
  1106.     CASE p_calc $ "SUM,CNT,MAX,MIN"
  1107.       REPLACE &lc_rtcol WITH ln_tarray[ ln_columns + 2 ]
  1108.     CASE p_calc = "AVG"
  1109.       REPLACE &lc_rtcol WITH ln_tarray[ ln_columns + 2 ] / ;
  1110.                              ln_narray[ ln_columns + 2 ]
  1111.     OTHERWISE
  1112.       ln_var = ( ln_sqarray[ ln_columns + 2 ] -  ;
  1113.                  ln_tarray[ ln_columns + 2 ] *   ;
  1114.                  ln_tarray[ ln_columns + 2 ] /   ;
  1115.                  ln_narray[ ln_columns + 2 ] ) / ;
  1116.                  ln_narray[ ln_columns + 2 ]
  1117.       REPLACE &lc_rtcol WITH iif(p_calc = "VAR", ln_var, sqrt(ln_var))
  1118.   ENDCASE
  1119.   INDEX ON Seq TAG Seq
  1120.   GO BOTTOM
  1121.   REPLACE &lc_psidfld WITH "Summary"
  1122.   SELECT 1
  1123.  
  1124. ** End of long section added by JP; end that can be removed for no summaries.
  1125.  
  1126.   @ 5, 50 SAY "Complete"
  1127.   @ 6, 5 SAY lc_stat5 + + CHR(205) + CHR(205) + CHR(16)
  1128.   @ 6, 50 SAY "Working"
  1129.  
  1130. *-- Remove the UNIQUE Tags on the data file
  1131.   DELETE TAG topfld
  1132.   DELETE TAG sidfld
  1133.  
  1134. *-- Put the CROSSTAB and columns into view
  1135.   CLOSE DATABASE
  1136.   SELECT 1
  1137.   USE crosstab ORDER TAG Seq
  1138.   USE columns IN 2 ORDER TAG column
  1139.  
  1140. *-- Create the field column labels
  1141.   SET FIELDS TO &lc_psidfld. /R
  1142.   SET FIELDS OFF
  1143.   ln_col = 1
  1144.   DO WHILE ln_col <= ln_columns
  1145.     lc_colname = "COL" + SUBSTR( STR( 100 + ln_col, 3, 0), 2, 2 )
  1146.     lc_coltitl = LOOKUP( columns->&lc_ptopfld, lc_colname, columns->column )
  1147.     lc_coltitl = XT_ClnTl( (lc_coltitl) )
  1148.     SET FIELDS TO &lc_coltitl = ( &lc_colname )
  1149.     SET FIELDS OFF
  1150.     ln_col = ln_col + 1
  1151.   ENDDO
  1152.  
  1153. **  Name the field for the row totals; last change by JP; remove for no summary
  1154.   SET FIELDS TO Summary = &lc_rtcol
  1155.  
  1156.   SET FIELDS ON
  1157.  
  1158.   @ 6, 50 SAY "Complete"
  1159.   DO XT_RestEv
  1160. RETURN
  1161. *-- EOP: Com_XTab
  1162.  
  1163.